home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / fevent.test < prev    next >
Text File  |  1995-06-28  |  10KB  |  352 lines
  1. # This file is a Tcl script to test the "fileevent" command.  It is
  2. # organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1994 The Regents of the University of California.
  5. # Copyright (c) 1994 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # @(#) fevent.test 1.11 95/06/25 14:52:38
  11.  
  12. if {[info procs test] != "test"} {
  13.     source defs
  14. }
  15.  
  16. foreach i [winfo children .] {
  17.     destroy $i
  18. }
  19. . configure -width 200 -height 200
  20. wm geometry . {}
  21. raise .
  22. update
  23. . configure -width 0 -height 0
  24.  
  25. set f [open foo w+]
  26. set f2 [open {|cat -u} r+]
  27. set f3 [open {|cat -u} r+]
  28. test fevent-1.1 {Tk_FileeventCmd: errors} {
  29.     list [catch {fileevent foo} msg] $msg
  30. } {1 {wrong # args: must be "fileevent fileId event ?script?}}
  31. test fevent-1.2 {Tk_FileeventCmd: errors} {
  32.     list [catch {fileevent foo bar baz q} msg] $msg
  33. } {1 {wrong # args: must be "fileevent fileId event ?script?}}
  34. test fevent-1.3 {Tk_FileeventCmd: errors} {
  35.     list [catch {fileevent gorp readable} msg] $msg
  36. } {1 {bad file identifier "gorp"}}
  37. test fevent-1.4 {Tk_FileeventCmd: errors} {
  38.     list [catch {fileevent gorp writable} msg] $msg
  39. } {1 {bad file identifier "gorp"}}
  40. test fevent-1.5 {Tk_FileeventCmd: errors} {
  41.     list [catch {fileevent gorp who-knows} msg] $msg
  42. } {1 {bad event name "who-knows": must be readable or writable}}
  43.  
  44. test fevent-2.1 {Tk_FileeventCmd: creating, deleting, querying} {
  45.     list [fileevent $f readable] [fileevent $f writable]
  46. } {{} {}}
  47. test fevent-2.2 {Tk_FileeventCmd: creating, deleting, querying} {
  48.     set result {}
  49.     fileevent $f readable "script 1"
  50.     lappend result [fileevent $f readable] [fileevent $f writable]
  51.     fileevent $f writable "write script"
  52.     lappend result [fileevent $f readable] [fileevent $f writable]
  53.     fileevent $f readable {}
  54.     lappend result [fileevent $f readable] [fileevent $f writable]
  55.     fileevent $f writable {}
  56.     lappend result [fileevent $f readable] [fileevent $f writable]
  57. } {{script 1} {} {script 1} {write script} {} {write script} {} {}}
  58. test fevent-2.3 {Tk_FileeventCmd: deleting when many present} {
  59.     set result {}
  60.     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
  61.     fileevent $f r "read f"
  62.     fileevent $f2 r "read f2"
  63.     fileevent $f3 r "read f3"
  64.     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
  65.     fileevent $f2 r {}
  66.     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
  67.     fileevent $f3 r {}
  68.     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
  69.     fileevent $f r {}
  70.     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
  71. } {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
  72.  
  73. test fevent-3.1 {Tk_FileeventCmd: replacing} {
  74.     set result {}
  75.     fileevent $f r "first script"
  76.     lappend result [fileevent $f readable]
  77.     fileevent $f r "new script"
  78.     lappend result [fileevent $f readable]
  79.     fileevent $f r "yet another"
  80.     lappend result [fileevent $f readable]
  81.     fileevent $f r ""
  82.     lappend result [fileevent $f readable]
  83. } {{first script} {new script} {yet another} {}}
  84.  
  85. test fevent-4.1 {FileEventProc procedure: normal read event} {
  86.     fileevent $f2 readable {set x [gets $f2]; fileevent $f2 readable {}}
  87.     puts $f2 text; flush $f2
  88.     after 500
  89.     set x initial
  90.     update
  91.     set x
  92. } {text}
  93. test fevent-4.2 {FileEventProc procedure: error in read event} {
  94.     proc tkerror args {
  95.     global x
  96.     set x $args
  97.     }
  98.     fileevent $f2 readable {error bogus}
  99.     puts $f2 text; flush $f2
  100.     after 200
  101.     set x initial
  102.     update
  103.     rename tkerror {}
  104.     list $x [fileevent $f2 readable]
  105. } {bogus {}}
  106. test fevent-4.3 {FileEventProc procedure: normal write event} {
  107.     fileevent $f2 writable {
  108.     lappend x "triggered"
  109.     incr count -1
  110.     if {$count <= 0} {
  111.         fileevent $f2 writable {}
  112.     }
  113.     }
  114.     set x initial
  115.     set count 3
  116.     update
  117.     set x
  118. } {initial triggered triggered triggered}
  119. test fevent-4.4 {FileEventProc procedure: eror in write event} {
  120.     proc tkerror args {
  121.     global x
  122.     set x $args
  123.     }
  124.     fileevent $f2 writable {error bad-write}
  125.     set x initial
  126.     update
  127.     rename tkerror {}
  128.     list $x [fileevent $f2 writable]
  129. } {bad-write {}}
  130. test fevent-4.5 {FileEventProc procedure: end of file} {
  131.     set f4 [open {|cat << foo} r]
  132.     fileevent $f4 readable {
  133.     if {[gets $f4 line] < 0} {
  134.         lappend x eof
  135.         fileevent $f4 readable {}
  136.     } else {
  137.         lappend x $line
  138.     }
  139.     }
  140.     after 200
  141.     set x initial
  142.     update
  143.     close $f4
  144.     set x
  145. } {initial foo eof}
  146.  
  147. close $f
  148. close $f2
  149. close $f3
  150. exec echo foo bar > foo
  151. test fevent-5.1 {DeleteFileEvent, cleanup on close} {
  152.     set f [open foo r]
  153.     fileevent $f readable {
  154.     lappend x "binding triggered: \"[gets $f]\""
  155.     fileevent $f readable {}
  156.     }
  157.     close $f
  158.     set x initial
  159.     update
  160.     set x
  161. } {initial}
  162. test fevent-5.2 {DeleteFileEvent, cleanup on close} {
  163.     set f [open foo r]
  164.     set f2 [open foo r]
  165.     fileevent $f readable {
  166.         lappend x "f triggered: \"[gets $f]\""
  167.         fileevent $f readable {}
  168.     }
  169.     fileevent $f2 readable {
  170.     lappend x "f2 triggered: \"[gets $f2]\""
  171.     fileevent $f2 readable {}
  172.     }
  173.     close $f
  174.     set x initial
  175.     update
  176.     close $f2
  177.     set x
  178. } {initial {f2 triggered: "foo bar"}}
  179. test fevent-5.3 {DeleteFileEvent, cleanup on close} {
  180.     set f [open foo r]
  181.     set f2 [open foo r]
  182.     set f3 [open foo r]
  183.     fileevent $f readable {f script}
  184.     fileevent $f2 readable {f2 script}
  185.     fileevent $f3 readable {f3 script}
  186.     set x {}
  187.     close $f2
  188.     lappend x [catch {fileevent $f readable} msg] $msg \
  189.         [catch {fileevent $f2 readable}] \
  190.         [catch {fileevent $f3 readable} msg] $msg
  191.     close $f3
  192.     lappend x [catch {fileevent $f readable} msg] $msg \
  193.         [catch {fileevent $f2 readable}] \
  194.         [catch {fileevent $f3 readable}]
  195.     close $f
  196.     lappend x [catch {fileevent $f readable}] \
  197.         [catch {fileevent $f2 readable}] \
  198.         [catch {fileevent $f3 readable}]
  199. } {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}
  200.  
  201. if {[info commands testfevent] == "testfevent"} {
  202.     test fevent-6.1 {Tk_EventInit procedure} {
  203.     testfevent create
  204.     testfevent cmd {
  205.         set f [open foo r]
  206.         set x "no event"
  207.         fileevent $f readable {
  208.         set x "f triggered: [gets $f]"
  209.         fileevent $f readable {}
  210.         }
  211.     } 
  212.     update
  213.     testfevent cmd {close $f}
  214.     list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
  215.     } {{f triggered: foo bar} after}
  216.     test fevent-6.2 {Tk_EventInit procedure} {
  217.     testfevent create
  218.     list [catch {testfevent cmd {tkwait window .x}} msg] $msg]
  219.     } {1 {bad option "window": must be variable]}}
  220.     test fevent-6.3 {Tk_EventInit procedure} {
  221.     testfevent create
  222.     list [catch {testfevent cmd {tkwait visibility .x}} msg] $msg]
  223.     } {1 {bad option "visibility": must be variable]}}
  224.     test fevent-6.4 {Tk_EventInit procedure} {
  225.     testfevent create
  226.     testfevent cmd {
  227.         set x 0
  228.         after 10 {set x triggered}
  229.         tkwait variable x
  230.         set x
  231.     }
  232.     } {triggered}
  233.     test fevent-6.5 {Tk_EventInit procedure} {
  234.     testfevent create
  235.     testfevent cmd {
  236.         set x 0
  237.         after 10 {lappend x timer}
  238.         after 30
  239.         set result $x
  240.         update idletasks
  241.         lappend result $x
  242.         update
  243.         lappend result $x
  244.     }
  245.     } {0 0 {0 timer}}
  246.     test fevent-6.6 {Tk_EventInit procedure} {
  247.     button .b -text "Test button"
  248.     place .b -x 5 -y 10
  249.     update
  250.     bind .b <Expose> {lappend x exposed}
  251.     set x initial
  252.     place .b -height 100
  253.     testfevent create
  254.     testfevent cmd {
  255.         update
  256.     }
  257.     lappend x |
  258.     update
  259.     # destroy .b
  260.     set x
  261.     } {initial | exposed}
  262.  
  263.     test fevent-7.1 {TkEventCleanupProc procedure} {
  264.     set f [open foo r]
  265.     set f2 [open foo r]
  266.     set f3 [open foo r]
  267.     fileevent $f readable {script 1}
  268.     testfevent create
  269.     testfevent cmd "fileevent $f2 readable {script 2}"
  270.     fileevent $f3 readable {sript 3}
  271.     set x {}
  272.     lappend x [fileevent $f2 readable]
  273.     testfevent delete
  274.     lappend x [fileevent $f readable] [fileevent $f2 readable] \
  275.         [fileevent $f3 readable]
  276.     close $f
  277.     close $f2
  278.     close $f3
  279.     set x
  280.     } {{script 2} {script 1} {} {sript 3}}
  281.     test fevent-7.2 {TkEventCleanupProc procedure} {
  282.     set f [open foo r]
  283.     set f2 [open foo r]
  284.     set f3 [open foo r]
  285.     set f4 [open foo r]
  286.     fileevent $f readable {script 1}
  287.     testfevent create
  288.     testfevent cmd "fileevent $f2 readable {script 2}
  289.         fileevent $f3 readable {script 3}"
  290.     fileevent $f4 readable {script 4}
  291.     testfevent delete
  292.     set x [list [fileevent $f readable] [fileevent $f2 readable] \
  293.         [fileevent $f3 readable] [fileevent $f4 readable]]
  294.     close $f
  295.     close $f2
  296.     close $f3
  297.     close $f4
  298.     set x
  299.     } {{script 1} {} {} {script 4}}
  300.     test fevent-7.3 {TkEventCleanupProc procedure} {
  301.     set f [open foo r]
  302.     set f2 [open foo r]
  303.     set f3 [open foo r]
  304.     set f4 [open foo r]
  305.     testfevent create
  306.     fileevent $f readable {script 1}
  307.     fileevent $f2 readable {script 2}
  308.     testfevent cmd "fileevent $f3 readable {script 3}
  309.         fileevent $f4 readable {script 4}"
  310.     testfevent delete
  311.     set x [list [fileevent $f readable] [fileevent $f2 readable] \
  312.         [fileevent $f3 readable] [fileevent $f4 readable]]
  313.     close $f
  314.     close $f2
  315.     close $f3
  316.     close $f4
  317.     set x
  318.     } {{script 1} {script 2} {} {}}
  319.     test fevent-7.4 {TkEventCleanupProc procedure} {
  320.     set f [open foo r+]
  321.     testfevent create
  322.     fileevent $f readable {read script}
  323.     testfevent cmd "fileevent $f writable {write script}"
  324.     testfevent delete
  325.     set x [list [fileevent $f readable] [fileevent $f writable]]
  326.     close $f
  327.     set x
  328.     } {{read script} {}}
  329.     test fevent-7.5 {TkEventCleanupProc procedure} {
  330.     set f [open foo r+]
  331.     testfevent create
  332.     fileevent $f writable {write script}
  333.     testfevent cmd "fileevent $f readable {read script}"
  334.     testfevent delete
  335.     set x [list [fileevent $f readable] [fileevent $f writable]]
  336.     close $f
  337.     set x
  338.     } {{} {write script}}
  339.     test fevent-7.6 {TkEventCleanupProc procedure} {
  340.     set f [open foo r+]
  341.     testfevent create
  342.     testfevent cmd "fileevent $f readable {read script}
  343.         fileevent $f writable {write script}"
  344.     testfevent delete
  345.     set x [list [fileevent $f readable] [fileevent $f writable]]
  346.     close $f
  347.     set x
  348.     } {{} {}}
  349.     testfevent delete
  350. }
  351. exec rm foo
  352.